perm filename XLIST.F4[CMS,LCS] blob sn#080728 filedate 1974-01-09 generic text, type T, neo UTF8
00100		DIMENSION JA(8,200),JB(4,200),JC(4,200),JD(5,200)
00200	8	K=0
00300	1	TYPE 6
00400	6	FORMAT(' NEW FILE OR OLD?'/)	
00500		ACCEPT 10,M
00600	  	TYPE 22
00700	22	FORMAT(' TYPE FILE NAME.'/)
00800		ACCEPT 23,F
00900	23	FORMAT(A4)
01000		IF(M.EQ.'O')GO TO 43
01100	10	FORMAT(A1)
01200	15	TYPE 7
01300	7	FORMAT(' TYPE;<LINE 1>:NAME;<LINES 2AND3>:ADDRESS<;AND'/	
01400	 	1 ' <LINE 4>:UP TO 5 ONE LETTER,EXCEPT''Z'',LIST NAMES.'/)
01500	2	K=K+1
01600	  	TYPE 3
01700	3	FORMAT(' IF FINISHED TYPE <CR>.'/)
01800		ACCEPT 9,(JA(I,K),I=1,8)
01900	9	FORMAT(5A1,3A5)
02000		IF(JA(1,K).EQ.' ')GO TO 33
02100		ACCEPT 11,(JB(I,K),I=1,4)
02200	11	FORMAT(4A5)
02300		ACCEPT 11,(JC(I,K),I=1,4)
02400		ACCEPT 20,(JD(I,K),I=1,5)
02500	20   	FORMAT(5A1)
02600		GO TO 2
02700	43	REWIND 1
02800		CALL IFILE(1,F)
02900		READ(1)JB
03000		READ(1)JA
03100		READ(1)JC,K
03200		TYPE 66
03300	66	FORMAT(' PRINTOUT OR ADD NAMES?'/)
03400		ACCEPT 67,P
03500	67	FORMAT(A1)
03600		IF(P.EQ.'P')GO TO 60
03700		GO TO 15
03800	33	K=K-1
03900		REWIND 1
04000		CALL OFILE(1,F)
04100		WRITE(1)JB,K
04200		WRITE(1)JA,K
04300		WRITE(1)JC,K,K
04400	60	TYPE 77
04500	77	FORMAT(' TYPE LIST NAME OR Z FOR ALL LISTS.'/)
04600		ACCEPT 78,X 
04700	78	FORMAT(A1)
04800		Y=' '
04900	 	IF(X.EQ.'Z')GO TO 53
05000		N=0
05100		DO 99 L=1,K
05200		DO 97 I=1,5
05300		IF(JD(I,L).EQ.X)GO TO 98
05400	97	CONTINUE
05500		GO TO 99
05600	98	N=N+1
05700		DO 51 M=1,8
05800	51	JA(M,N)=JA(M,L)
05900		DO 102 M=1,4
06000		JB(M,N)=JB(M,L)
06100	102	JC(M,N)=JC(M,L)
06200		DO 100 M=1,5
06300	100	JD(M,N)=JD(M,L)
06400		WRITE(5,91)(JA(I,N),I=1,8)
06500	91	FORMAT(/4X5A1,3A5)
06600	99	CONTINUE
06700		K=N
06800	53	Y='Y'
06900	  	TYPE 13
07000	13	FORMAT(' TTY OR LINE PRINTER?'/)
07100		ACCEPT 17,T
07200	17	FORMAT(A1)
07300		IF(T.NE.'L')GO TO 103
07400	  	TYPE 88
07500	88	FORMAT(' PRINT WITH LIST NAMES?'/)
07600		ACCEPT 90,Y
07700	90	FORMAT(A1)
07800	103	LIST=5
07900		IF(T.EQ.'L')LIST=3
08000		DO 45 J=1,K,3
08100		WRITE(LIST,19)((JA(I,L),I=1,8),L=J,J+2)                                
08200	19	FORMAT(//3(4X5A1,3A5))
08300		WRITE(LIST,46)((JB(I,L),I=1,4),L=J,J+2)
08400	46	FORMAT(3(4X4A5))
08500		WRITE(LIST,46)((JC(I,L),I=1,4),L=J,J+2)
08600		IF(Y.NE.'Y')GO TO 45
08700		WRITE(LIST,48)((JD(I,L),I=1,5),L=J,J+2)
08800	48	FORMAT(/3(19X5A1))
08900	45	CONTINUE
09000		IF(T.EQ.'L')CALL EXIT
09100		GO TO 8
09200		END